perm filename XGPFOO.SAI[PIX,HPM] blob
sn#417656 filedate 1979-02-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "XGPSYN"
C00014 00003 DBUG←FALSE
C00016 00004 CHAN←GETCHAN
C00020 00005 FPN←1 FPNR←0 S←"" PN←2
C00023 00006 DO
C00034 00007 IF PAGE ∧ PN>0 THEN
C00036 00008 comment assemble line of text
C00037 00009 comment calculate height of line
C00043 00010 comment assemble line
C00057 00011 comment display page
C00061 ENDMK
C⊗;
BEGIN "XGPSYN"
REQUIRE 7500 STRING_SPACE;
REQUIRE "FNTHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "SYNSUB.REL[PIX,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE HELPER;
EXTERNAL PROCEDURE NOCHAN;
EXTERNAL PROCEDURE FEWCHN(INTEGER N);
EXTERNAL PROCEDURE FIRST;
EXTERNAL PROCEDURE FIRST1;
EXTERNAL PROCEDURE FIRST2;
EXTERNAL PROCEDURE FIRST3;
EXTERNAL PROCEDURE CRLF;
EXTERNAL PROCEDURE FILNM;
EXTERNAL PROCEDURE FONTNO(INTEGER N);
BOOLEAN PRNT,XGP,DBUG,SPOOLFLAG,WHITELET,OWNCH,HELPACT,AUTOCR;
INTEGER NCOPY;
INTEGER ARRAY FHD[0:'177,0:'203];
INTEGER FNTN,SFNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER INTERCHAR,UINTERCHAR,SINTERCHAR,LINLEN, LISTLO,LISTHI, LASTUSETI;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,DENS,LUND,SDENS;
INTEGER NCHN,I,J,K,NUMCH,TXTPNT;
INTEGER PN1,PN2,PN3,PN4;
INTEGER XSHIFT,YSHIFT;
DEFINE PAGEMAX=500;
INTEGER ARRAY PNS[0:PAGEMAX];
REAL FPN,FPNR;
STRING INSTR,INFILE,S,SWT,SPOOLF;
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
INTEGER T;
IF LENGTH(INSTR)=0 ∧ ¬EOF THEN INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; IDPB(T←LOP(INSTR),TXTPNT);
EOF←EOF ∨ NUMCH≥LASTUSETI;
RETURN(T);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
STRING PROCEDURE SKIPTO(INTEGER DELIM);
BEGIN
STRING RET;
RET←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS≠DELIM ∧ FNTNMS≠"/" ∧ FNTNMS≠"#"
DO RET←RET&LOP(FNTNMS);
RETURN(RET);
END;
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 1],"F") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="#" THEN FTNO←INTSCAN(FNTNMS,FOO) ELSE FTNO←0;
FNTNMS←FNTNMS[2 TO ∞];
FTNM←SKIPTO("=");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM," "); END;
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM); END;
END;
IF FNTNMS="=" THEN
BEGIN
INTEGER ARRAY TERM[0:'177]; INTEGER I;
FNTNMS←FNTNMS[2 TO ∞];
ARRCLR(TERM);
DO BEGIN I←LOP(FNTNMS); TERM[I]←TERM[I]+1; END UNTIL TERM[I]≥2;
END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"RE") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="=" THEN
BEGIN
FNTNMS←FNTNMS[2 TO ∞];
NCOPY←INTSCAN(FNTNMS,FOO);
END
ELSE NCOPY←2;
IF HELPACT THEN PRINT("REPEAT=",NCOPY," ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"TM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN TMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("TMAR=",TMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"PM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN PMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("PMAR=",PMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"BM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN BMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("BMAR=",BMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"LM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN LMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("LMAR=",LMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"RM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN RMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("RMAR=",RMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XL") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XLINE←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XLINE=",XLINE," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XO") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XOFF←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XOFF=",XOFF," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"YO") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN YOFF←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("YOFF=",YOFF," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"IN") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN UINTERCHAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("INTERCHAR=",UINTERCHAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XSHIFT=",XSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"YS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN YSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("YSHIFT=",YSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XG") THEN
BEGIN
SKIPTO("/");
XGP←TRUE;
IF HELPACT THEN PRINT("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOX") THEN
BEGIN
SKIPTO("/");
XGP←FALSE;
AUTOCR←TRUE;
IF HELPACT THEN PRINT("NOXGP ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"AUT") THEN
BEGIN
SKIPTO("/");
AUTOCR←TRUE;
IF HELPACT THEN PRINT("AUTOCR ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOA") THEN
BEGIN
SKIPTO("/");
AUTOCR←FALSE;
IF HELPACT THEN PRINT("NOAUTOCR ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"U") THEN
BEGIN
INTEGER FOO;
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN IF HELPACT THEN PRINT("USETI ");
USETI(CHAN,LASTUSETI←INTSCAN(FNTNMS,FOO));
LASTUSETI←(LASTUSETI-1)*'200*5; comment terminating character;
FNTNMS←"";
WHILE ¬EOF DO FNTNMS←FNTNMS&INPUT(CHAN,1);
LASTFF←10000; END;
END;
END;
END;
PROCEDURE SETOFFSET;
CASE DENS OF
BEGIN
["T"] BEGIN YOFF←-36; XOFF←0; END;
["B"] BEGIN YOFF←-YSHIFT; XOFF←-36-XSHIFT; END;
["E"] BEGIN YOFF←TMAR; XOFF←LMAR; END;
["H"] BEGIN YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30)-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10; END;
["F"] BEGIN YOFF←TMAR-((512*4-PMAR)%2 MAX 0)+FPNR*512*4;
XOFF←((LMAR-20) MIN (RMAR-3*480)) MAX -10; END;
["D"] BEGIN YOFF←TMAR+FPNR*481*4-20; XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END;
["P"] BEGIN YOFF←-YSHIFT; XOFF←-XSHIFT; END
END;
STRING PROCEDURE GETINCHWL;
BEGIN
PRELOAD_WITH 0; OWN INTEGER ARRAY INDEX[1:1];
IF INDEX[1]=0∧SPOOLFLAG∧(EOF ∨ LISTLO>LISTHI) THEN
BEGIN
SPOOLFLAG←FALSE;
PRINT("listing finished"); CRLF; DENS←SDENS;
CASE DENS OF
BEGIN
["D"] BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
["F"]["B"]["E"] BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END
END;
END;
IF SPOOLFLAG THEN
BEGIN
INDEX[1]←(INDEX[1]+1) MOD 2;
IF INDEX[1]=1 THEN LISTLO←LISTLO+1;
RETURN(IF INDEX[1]=1 THEN CVS(LISTLO-1) ELSE "X");
END
ELSE RETURN(INCHWL);
END;
DBUG←FALSE;
HELPACT←FALSE;
OWNCH←SYNMAP(1)<0;
IF OWNCH THEN
BEGIN
INTEGER I;
PRINT("Too few synthesizer channels, output will be on your screen"); CRLF;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
END
ELSE
BEGIN
NCHN←0; FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN NOCHAN ELSE IF NCHN<3 THEN FEWCHN(NCHN);
END;
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I");
BREAKSET(1,"","O"); BREAKSET(1,"","Z");
DDINIT;
NCOPY←1;
LASTUSETI←2↑34;
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
AUTOCR←TRUE;
XLINE←4;
XSHIFT←YSHIFT←0;
UINTERCHAR←0;
SPOOLFLAG←FALSE;
WHITELET←FALSE;
ARRCLR(PNS,-1);
BEGIN "FILE"
DEFINE FSIZE=10000;
INTEGER FOO,HIG,POS,I,J; INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS; BOOLEAN PAGE;
FCACHE(FONT[0],FSIZE);
FNTSEL(0,"GACS25.FNT[XGP,SYS]",FHD[0,0]); comment select the default font;
CHAN←GETCHAN;
START_CODE TTCALL '10,0; END; comment RESCAN to read command line;
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
WHILE LENGTH(S)≠0 ∧ S[1 TO 1]≠";" DO S←S[2 TO ∞];
IF LENGTH(S)>0 THEN S←S[2 TO ∞] ELSE
BEGIN PRINT("Type ?<cr> for help"); CRLF; CRLF; END;
DO
BEGIN
STRING SF;
IF LENGTH(S)=0 THEN
BEGIN
FILNM; IF HELPACT THEN FIRST3; PRINT(":");
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
END;
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN BEGIN HELPACT←TRUE; HELPER; END ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
IF EOF THEN S←"";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
IF XGP THEN AUTOCR←FALSE; comment don't break at EOL in XGP files;
NUMCH←0; TXTPNT←POINT(7,DBUF,-1);
IF LENGTH(S)>0 THEN SWITCHES(S); comment parse any spooler style switches;
LASTFF←0; PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR 0;
IF XGP THEN
BEGIN
INTEGER NX;
SPOOLF←"XS "&DEVPRS&":"&FILPRS&"/NOTITLE/NOHEAD"&'15&'12;
SWT←"";
WHILE (NX←NXCH)≠'14 DO IF ¬(NX='15∨NX='12∨NX=" ") THEN SWT←SWT&NX;
SWITCHES(SWT);
IF LMAR=50∧PMAR=0 THEN BEGIN LMAR←120; TMAR←120; END; comment TEX defaults;
IF LMAR=0 THEN LMAR←150; comment LMAR=0, PUB default;
IF PMAR=0 THEN PMAR←2200-TMAR-BMAR; comment can't support indefinite pages;
PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR NUMCH;
END;
FNTN←PNS[0] LSH -29; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[0] LSH -22) LAND '177;
CRLF;
FPN←1; FPNR←0; S←""; PN←2;
IF OWNCH THEN BEGIN PRINT("Half density"); CRLF; DENS←"H"; END
ELSE BEGIN PRINT("Full density"); CRLF; DENS←"F"; END;
WHILE TRUE DO
BEGIN "DENSITY"
XCMP←IF DENS="P"∨DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="D" THEN 6 ELSE 3;
YCMP←IF DENS="P"∨DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF DENS="P" THEN 66 ELSE
IF DENS="B" THEN TMAR+PMAR+BMAR ELSE
IF DENS="T" THEN RMAR
ELSE 481,
WI←IF DENS="P" THEN 85 ELSE
IF DENS="B" THEN 1700+37 ELSE
IF DENS="T" THEN
(TMAR+PMAR+BMAR+37) MIN 1700
ELSE 512,
BI←IF DENS="P" THEN 7
ELSE IF DENS="H" THEN 3
ELSE IF DENS="F" THEN 4
ELSE IF DENS="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
IF ¬OWNCH THEN
BEGIN
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
BEGIN
IF NCHN=0 THEN PRINT("No synthesizer channels.") ELSE
PRINT(PIC[BYBI]-NCHN," synthesizer channel",
IF PIC[BYBI]-NCHN=1 THEN "" ELSE "s"," too few.");
CRLF;
END;
END;
DO
BEGIN "PAGES"
INTEGER FOO;
IF ¬SPOOLFLAG∧¬OWNCH THEN
IF DENS="D" THEN
BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE IF DENS="F" ∨ DENS="B" ∨ DENS="E" ∨ DENS="P" THEN
BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END;
TTYUP(TRUE); S←GETINCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
INTEGER IPN;
IPN←FPN;
FPNR←FPN-IPN;
FPN←IPN;
PAGE←TRUE;
END
ELSE IF (S LAND '137)="L" THEN
BEGIN
IF LENGTH(S)≤1 THEN BEGIN LISTLO←1; LISTHI←9999; END
ELSE
BEGIN
S←S[2 TO ∞];
LISTLO←INTSCAN(S,FOO); LISTHI←INTSCAN(S,FOO);
IF LISTHI=0 THEN LISTHI←LISTLO;
END;
EOF←FALSE;
PRINT("listing ",LISTLO,":",LISTHI," ..."); CRLF;
SDENS←DENS;
DENS←"B";
SPOOLFLAG←TRUE;
PN←-1;
PAGE←FALSE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF DENS="E" THEN
BEGIN
OUTSTR("White on black?");
SCREEN(0,0,1,1); DDINIT; LITEN;
IF (INCHWL LAND '137)="Y" THEN RECTAN(0,0,1,1);
VIDONE(PIC[0],'77);
OUTSTR("SIZE(-5 to 5):");
FOR I←1 STEP 1 UNTIL NCOPY DO XGPUP(CVD(INCHWL));
END
ELSE
FOR I←1 STEP 1 UNTIL NCOPY DO
IF DENS="B" THEN VIDXGP(PIC[0],YOFF+YSHIFT,XOFF+XSHIFT,
TMAR+PMAR+BMAR-J) ELSE
IF DENS="T" THEN VIDXGP(PIC[0],0,YOFF,RMAR)
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
IF DENS="P" THEN
BEGIN
INTEGER I,J,K;
FOR J←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
K←PIC[LNBY]-1; WHILE K≥0 ∧ PIXEL(PIC[0],J,K)=0 DO K←K-1;
FOR I←0 STEP 1 UNTIL K DO
OUTSTR(IF PIXEL(PIC[0],J,I)=0 THEN '40 ELSE
PIXEL(PIC[0],J,I));
PRINT('15&'12);
END;
END
ELSE
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨OWNCH
THEN 0 ELSE DDSIZ];
DDINIT;
IF ¬OWNCH THEN
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI]);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); CRLF;
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
END;
END;
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
PRINT("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
IF OWNCH THEN ERASE(-1) ELSE MAPGRY(-1,0);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="Q" THEN
BEGIN
LODED(SPOOLF);
CALL(0,"EXIT");
PAGE←FALSE;
END
ELSE IF (S LAND '137)="W" THEN
BEGIN
WHITELET←¬WHITELET;
IF WHITELET THEN PRINT("White letters on black")
ELSE PRINT("Black letters on white");
CRLF;
BEGIN
INTEGER I,J,K;
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="S" THEN
BEGIN
INTEGER I;
OWNCH←¬OWNCH;
IF OWNCH THEN
BEGIN
PRINT("on your display"); CRLF;
PRINT("half density"); DENS←"H";
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
END
ELSE
BEGIN
PRINT("on video synthesizer");
MAPGRY(1,1,TRUE);
END;
CRLF;
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
HELPACT←TRUE;
HELPER;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" ∨ (S LAND '137)="E"
∨ (S LAND '137)="P" THEN
BEGIN
S←S LAND '137;
PRINT( IF S="P" THEN "printout ASCII" ELSE
IF S="B" THEN "bitwise resolution" ELSE
IF S="E" THEN "enormous resolution" ELSE
IF S="T" THEN "bitwise resolution, transposed" ELSE
IF S="F" THEN "full density" ELSE
IF S="H" THEN "half density"
ELSE "double density"); CRLF;
DENS←S;
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO);
IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN BEGIN PN←FPN; SETOFFSET; END;
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
INTEGER PNSLASTFF;
LASTFF←PN-1;
LASTFF←LASTFF MIN PAGEMAX;
WHILE LASTFF>0 ∧ PNS[LASTFF]=-1 DO LASTFF←LASTFF-1;
PNSLASTFF←PNS[LASTFF] LAND '17777777;
EOF←FALSE;
USETI(CHAN,1+PNSLASTFF%('200*5));
EOF←EOF ∨ PNSLASTFF≥LASTUSETI;
INSTR←""; NUMCH←(PNSLASTFF%('200*5))*'200*5;
FOR I←(PNSLASTFF MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
FNTN←PNS[LASTFF] LSH -29;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[LASTFF] LSH -22) LAND '177;
END;
WIPE(PIC[0],0);
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0;
WHILE ¬EOF ∧ LASTFF<(IF DENS="D" THEN PN+1 ELSE PN) DO
BEGIN "NOTEOF"
INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF DENS="D" ∧ LASTFF=PN THEN
XOFF←(((LMAR-20) MIN (RMAR-3*512))MAX -10)-512*3;
IF DENS="D" ∧ LASTFF≠PN THEN
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
comment calculate height of line;
SBASE←BASE; SFNTN←FNTN; XPOS←LMAR; SINTERCHAR←INTERCHAR;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE; LINLEN←0;
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
CASE PN1←NXCH OF
BEGIN
[0]
QUICK_CODE
SETO 1,;
IBP 1,TXTPNT; comment ADJBP;
MOVEM 1,TXTPNT;
END;
['177] CASE PN2←NXCH OF
BEGIN
['1] CASE PN3←NXCH OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←PN3;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((NXCH LSH 29) ASH -29);
['52] BASE←BASE+((NXCH LSH 29) ASH -29);
['40] XPOS←NXCH*128+NXCH;
['41]
BEGIN
YU←YU MAX (((PN4←NXCH) LSH 29) ASH -29);
YL←YL MIN ((PN4 LSH 29) ASH -29);
XPOS←XPOS+NXCH*128+NXCH;
END;
['42] BEGIN NXCH; DUN←TRUE; END;
['44] ;
['45] FOR I←NXCH STEP -1 UNTIL 1 DO NXCH;
['46] ;
['47]
BEGIN
INTEGER YP;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
END;
['50] INTERCHAR←NXCH;
['51]
BEGIN
INTEGER YP;
PN4←NXCH;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX (YP+PN4); YL←YL MIN YP;
END;
ELSE
END;
[2] XPOS←XPOS+((NXCH LSH 29) ASH -29);
[3] YPOS←NXCH*128+NXCH;
[4] FOR I←1 STEP 1 UNTIL 11 DO NXCH;
[5]
BEGIN
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←BASE+FTB;
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
IF (XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR)≤RMAR
∨ ¬AUTOCR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR;
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
LINLEN←LINLEN+1;
END
ELSE DUN←TRUE
END;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
ELSE
IF (XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR)≤RMAR
∨ ¬AUTOCR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
IF LASTFF≤PAGEMAX THEN
PNS[LASTFF]←(FNTN LSH 29) LOR
(INTERCHAR LSH 22) LOR NUMCH;
PRINT(LASTFF," ");
END;
DUN←TRUE;
END;
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE
END;
END "HEIGHT";
BASE←SBASE;
FNTN←SFNTN; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←SINTERCHAR;
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
XPOS←LMAR;
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
LINLEN←0;
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
CASE LDB(TXTPNT) OF
BEGIN
[0] ;
['177] CASE ILDB(TXTPNT) OF
BEGIN
['1] CASE ILDB(TXTPNT) OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←LDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((ILDB(TXTPNT) LSH 29) ASH -29);
['52] BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29);
['40]
BEGIN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT);
END;
['41]
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR XP←XPOS STEP 1 UNTIL XNEW DO
CASE DENS OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1);
["P"]BEGIN
INTEGER XC,YC;
XC←(((XP-XOFF)*85/1700) MAX 0) MIN (PIC[LNBY]-1);
YC←((YP*66/2200) MAX 0) MIN (PIC[PCLN]-1);
IF PIXEL(PIC[0],YC,XC)=0 THEN
PUTEL(PIC[0],YC,XC,"-");
END
END;
XPOS←XNEW;
END;
['42] YPOS←YPOS+YU+ILDB(TXTPNT);
['45]
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END;
['46] LUND←XPOS;
['47]
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
FOR XP←LUND STEP 1 UNTIL XPOS DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1);
["P"]BEGIN
INTEGER XC,YC;
XC←(((XP-XOFF)*85/1700) MAX 0) MIN (PIC[LNBY]-1);
YC←((YP*66/2200) MAX 0) MIN (PIC[PCLN]-1);
IF PIXEL(PIC[0],YC,XC)=0 THEN
PUTEL(PIC[0],YC,XC,"-");
END
END;
END;
['50] INTERCHAR←ILDB(TXTPNT);
['51]
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29));
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(YP+TH)%YCMP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],(YP+TH)%YCMP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,(YP+TH)%YCMP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP+TH,1);
["P"]BEGIN
INTEGER XC,YC;
XC←(((XP-XOFF)*85/1700) MAX 0) MIN (PIC[LNBY]-1);
YC←(((YP+TH)*66/2200) MAX 0) MIN (PIC[PCLN]-1);
IF PIXEL(PIC[0],YC,XC)=0 THEN
PUTEL(PIC[0],YC,XC,"-");
END
END;
END
END;
[2] XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29);
[3] YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL;
[4]
BEGIN
INTEGER J,K,X0,Y0,N,W,DX;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
X0←(X0 ASH 9)+(DX MIN 0);
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
FOR K←W-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+(X0 ASH -9)-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],J+Y0-YOFF,
K+(X0 ASH -9)-XOFF,1);
["F"] ADDEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1);
["T"] PUTEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF),
J+Y0-YOFF,1);
["P"]BEGIN
INTEGER XC,YC;
XC←(((K+(X0 ASH -9)-XOFF)*85/1700)
MAX 0) MIN (PIC[LNBY]-1);
YC←(((J+Y0-YOFF)*66/2200) MAX 0)
MIN (PIC[PCLN]-1);
IF PIXEL(PIC[0],YC,XC)=0 THEN
PUTEL(PIC[0],YC,XC,"-");
END
END;
X0←X0+DX;
END;
END;
[5]
BEGIN
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←FTB+BASE;
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
BEGIN
CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
["P"]BEGIN
INTEGER XC,YC;
XC←(((XPOS-XOFF)*85/1700) MAX 0) MIN (PIC[LNBY]-1);
YC←(((YPOS-BASE-YOFF)*66/2200) MAX 0) MIN (PIC[PCLN]-1);
PUTEL(PIC[0],YC,XC,LDB(TXTPNT));
END
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
END
END;
['12] YPOS←YPOS+YU+XLINE;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
['14] BEGIN XPOS←LMAR; YPOS←TMAR; END;
ELSE
BEGIN
CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
["P"]BEGIN
INTEGER XC,YC;
XC←(((XPOS-XOFF)*85/1700) MAX 0) MIN (PIC[LNBY]-1);
YC←(((YPOS-BASE-YOFF)*66/2200) MAX 0) MIN (PIC[PCLN]-1);
PUTEL(PIC[0],YC,XC,LDB(TXTPNT));
END
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
END
END;
END"ASSLP";
END "ASSEMBLE";
END "NOTEOF";
comment display page;
IF ¬SPOOLFLAG THEN
BEGIN "SPOOLF"
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨DENS="E"∨OWNCH
THEN 0 ELSE DDSIZ];
IF DENS="P" THEN
BEGIN
INTEGER I,J,K;
FOR J←0 STEP 1 UNTIL PIC[PCLN]-1 DO
BEGIN
K←PIC[LNBY]-1; WHILE K≥0 ∧ PIXEL(PIC[0],J,K)=0 DO K←K-1;
FOR I←0 STEP 1 UNTIL K DO
OUTSTR(IF PIXEL(PIC[0],J,I)=0 THEN '40 ELSE
PIXEL(PIC[0],J,I));
PRINT('15&'12);
END;
END
ELSE
BEGIN
IF WHITELET THEN
BEGIN
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
DDINIT;
IF ¬OWNCH THEN
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI]); GRAY(PIC[0]);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); IF HELPACT THEN FIRST2; CRLF;
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
END;
END;
END "SPOOLF";
IF DENS="H"∨DENS="T" THEN FPN←FPN+FPNR+.5 ELSE
IF DENS="F"∨DENS="B"∨DENS="P" THEN FPN←(PN←FPN)+1 ELSE
IF DENS="E" THEN FPN←FPN+FPNR+1/4.5 ELSE
IF DENS="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END "XGPSYN";